perm filename MORSER.F4[HAK,HPM] blob
sn#066981 filedate 1974-06-17 generic text, type T, neo UTF8
00100 DIMENSION IPER(10),INTR(10),LPHA(51),MORS(51)
00200 DATA IDOT/1/,IDASH/5/,IPOS/-1/,ISPAC/-5/,KMAX/10/,LNUM/51/
00300 DATA LAFG/1/,SPAV/-2.5/,DAV/2.5/
00400 DATA LPHA/'E','T','I','A','N','M','S','U','R','W','D'
00500 1,'K','G','O','H','V','F','L','P','J','B','X','C','Y','Z','Q'
00600 2,'5','4','3','2','1','6','7','8','9','0','%','?','+','"'
00650 3,'.','''','-',';','(',',',':','ε','\','@','$'/
00700 DATA MORS/1,2,4,5,7,8,13,14,16,17,22,23,25,26,40,41,43,49
00800 1,52,53,67,68,70,71,76,77,121,122,125,134,161,202,229
00900 2,238,241,242,374,400,401,448,455,484,608,637,644,692,715
00950 3,1823,3280,5747,10192/
01000 8 DO 4 I=1,10
01100 IPER(I)=0
01200 4 INTR(I)=0
01300 DO 1 I = 1,10
01400 3 CALL NEXT(100,IPER(I),IFY)
01500 GO TO (2,3),IFY
01600 2 CALL NEXT(4*ISPAC,INTR(I),IFY)
01700 II=I
01800 GO TO (5,6),IFY
01900 5 IF(FLOAT(INTR(I)).LE.SPAV) GO TO 7
02000 1 CONTINUE
02100 CALL MAXM(10,INTR,ISPAC,IPOS)
02150 SPAV=(-1.-SQRT(FLOAT(1+ISPAC*IPOS)))*.1+.9*SPAV
02200 GO TO 8
02300 6 LAFG=2
02400 II=I-1
02500 7 IF(II.LE.1) GO TO 12
02600 CALL MAXM(II,INTR,MAX,IPOS)
02700 IF(LAFG.EQ.1) ISPAC=MAX
02800 12 IF(I.NE.1) GO TO 10
02900 KS=KS+1
03000 IF(KS.LT.5) GO TO 9
03100 ISPAC=2*ISPAC
03200 10 KS=1
03250 9 SPAV=(-1.-SQRT(FLOAT(ISPAC*IPOS)))*.1+.9*SPAV
03300 CALL MAXM(I,IPER,MIN,MAX)
03400 IF(MAX.LT.2*MIN) GO TO 13
03500 IDOT=MIN
03600 IDASH = MAX
03650 DAV=(1.+SQRT(FLOAT(IDOT*IDASH)))*.1+.9*DAV
03700 13 ICHR=0
03800 DO 14 J=1,I
03900 K=1
04000 IF(FLOAT(IPER(J)).GT.DAV) K=2
04100 14 ICHR=ICHR*3+K
04200 I=1
04300 J=LNUM
04400 16 IF(I.GT.J) GO TO 15
04500 K=(I+J)/2
04600 IF(MORS(K)-ICHR) 19,18,17
04700 17 J=K-1
04800 GO TO 16
04900 19 I=K+1
05000 GO TO 16
05100 18 CALL CHAR(LPHA(K))
05300 GO TO (8,22),LAFG
05400 22 LAFG=1
05500 CALL CHAR(' ')
05700 GO TO 8
05800 15 CALL CHAR('-')
06000 GO TO 8
06100 END
06200
06300 SUBROUTINE MAXM(N,IR,MIN,MAX)
06400 DIMENSION IR(N)
06500 MAX=IR(1)
06600 MIN=MAX
06700 DO 1 I=1,N
06800 IF(IR(I).LT.MIN) MIN=IR(I)
06900 IF(IR(I).GT.MAX) MAX=IR(I)
07000 1 CONTINUE
07100 RETURN
07200 END
07300
07400 SUBROUTINE NEXT(MAX,LEN,IFY)
07401 COMMON/HREE/IGG
07500 DIMENSION IN(200)
07600 DATA IG/1/,I/1/,LEG/200/
07700 IFY=1
07800 GO TO (1,2),IG
07975 1 CALL MORSIN(IN,LEG)
08000 IG=2
08150 2 IF(IGG.NE.0.AND.IGG.NE.I) GO TO 4
08200 IF(IABS(IN(I)).GT.IABS(MAX)) GO TO 3
08300 CALL SLEEP(0)
08400 GO TO 2
08500 4 LEN=IN(I)
08800 I=MOD(I,LEG)+1
08900 IF(LEN*MAX.LT.0) GO TO 2
09000 RETURN
09100 3 LEN=IN(I)
09200 IFY=2
09300 CALL SLEEP(0)
09400 RETURN
09500 END